home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
COMMADIO
/
RBBS3.LZH
/
RBBS-SUB.BAS
< prev
next >
Wrap
BASIC Source File
|
1986-03-15
|
82KB
|
2,112 lines
' $linesize:132
' $title: 'RBBS-SUB.BAS CPC14-1A, Copyright 1986 by D. Thomas Mack'
' Copyright 1986 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBS-SUB.BAS
' Written by .........: D. Thomas Mack
' First Released .....: March 16, 1986
' Subsequent Releases.: none
' Copyright ..........: 1986
' Purpose.............: The Remote Bulleting Board System for the IBM PC,
' RBBS-PC.BAS utilizes a lot of common subroutines.
' These are incorporated within RBBS-SUB.BAS as
' seperately callable subroutines in order to free
' up as much code as possible within the 64K code
' segment used by RBBS-PC.BAS.
' Parameters..........: All parameters are passed via a COMMON statement.
'
' Subroutine Name Function of Subroutine
'
' ALLCAPS Convert a sting to all upper case characters
' AMORPM Calculate the current time as AM or PM
' ANSWERIT Answer the telephone when it rings
' BADFILE Check for system crash attempt with bad device name
' BADNAME Check for system crash attempt with bad file name
' CARRIER Test for Carrier present
' COMMINFO Get users baud rate and parity in a string format
' COPYWRIT Display RBBS-PC's copyright notice
' DELAYIT Wait number of seconds specified before returning
' FILELOCK Allow files to be shared among multiple RBBS-PC's
' FINDFREE Find amount of free space on a device
' FINDFUNC Find the function key, if any, that was depressed
' FINDIT Find if a file exists on a device
' FINDTIME Calculate the number of seconds since midnight
' GETCOMND Get RBBS-PC's node id from command line
' LINE25 Build and/or update line 25 of RBBS-PC's local screen
' LOGERROR Log error message to CALLERS file
' MODEMPUT Write a modem command string to the modem
' OPENWORK Open RBBS-PC's work file (number 2)
' PRINTIT Print line on the local PC running RBBS-PC printer
' READDEF Open and read RBBS-PC's ".DEF" file of parameters
' READPROF Read user's profile on return from a "door"
' SETBAUD Set baud rate in the 8250 chip of the RS232 interface
' SETCRLF Set up the necessary carriage return/line feed string
' SKIPLINE Write a blank line to the communications port
' TGET Read a line from the communications port
' TPUT Write a line to the communications port
' UPDTCALR Update to the caller's file
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
' $SUBTITLE: 'Error Handling for seperately compiled subroutines'
' $PAGE
'
' *****************************************************************************
' * Error handling for the seperately compiled subroutines of RBBS-PC *
' *****************************************************************************
'
'
' PRINTER ERROR HANDLING
'
65 PRINTER = FALSE
RESUME 13674
'
' ANSWERIT ERROR HANDLING
'
70 IF ERL <> 328 THEN _
RET.ERL = ERL
IF (ERL = 328 OR ERL = 275 OR ERL = 324) AND ERR = 57 THEN _
RESUME 328
IF ERL = 324 AND ERR = 69 THEN _
SUBROUTINE.PARAMETER = 5
EC = ERR
RESUME 327
'
' TPUT ERROR HANDLING
'
75 IF ERL <> 1477 THEN _
RET.ERR = ERR
IF ERR = 69 THEN _
SUBROUTINE.PARAMETER = -1 : _
RESUME 1477
IF ERR = 57 THEN _
RESUME 1477
EC = ERR
RESUME 1476
'
' TGET ERROR HANDLING
'
80 IF ERR = 57 THEN _
RESUME 1650
SUBROUTINE.PARAMETER = -1
EC = ERR
RESUME 1651
'
' FINDIT ERROR HANDLING
'
85 IF ERL = 20221 AND ERR = 53 THEN _
RESUME 20224
IF ERL = 20221 THEN _
EC = ERR : _
RESUME 20222
IF ERL = 20222 AND ERR = 52 THEN _
RESUME 20223
IF ERL = 20223 AND EC = 58 THEN _
EC = 64 : _
RESUME 20224
EC = ERR
RESUME 20224
'
' FINDFREE ERROR HANDLING
'
90 IF ERL = 52001 AND ERR = 53 AND Z$ = COMMENTS.FILE$ THEN _
CLOSE 2 : _
OPEN "O",2,COMMENTS.FILE$ : _
RESUME 52000
IF ERL = 52001 AND ERR = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
A$ = "Upload directory file missing. Please tell SYSOP" : _
SUBROUTINE.PARAMETER = 6 : _
CALL TPUT : _
RESUME 52002
EC = ERR
RESUME 52002
'
' OPENWORK ERROR HANDLING
'
95 EC = ERR
IF ERR = 52 THEN _
RESUME 58010
RESUME 58030
' $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright'
' $PAGE
'
' SUBROUTINE NAME -- COPYWRIT
'
' INPUT PARAMETERS -- NONE
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO DISPLAY RBBS-PC'S COPYRIGHT NOTICE ON THE LOCAL
' SYSOP'S SCREEN
'
SUB COPYWRIT STATIC
WIDTH 80
CLS
KEY OFF
LOCATE ,,0
PRINT TAB(60)"tm"
PRINT TAB(16) STRING$(15,205)" U S E R W A R E " STRING$(15,205)
PRINT
PRINT TAB(17)"Capital PC User Group User-Supported Software"
PRINT
PRINT TAB(5) CHR$(214) STRING$(66,196) CHR$(183)
FOR I = 1 TO 12
READ A$
PRINT TAB(5) CHR$(186);A$; SPACE$(66 - LEN(A$)); CHR$(186)
NEXT
PRINT TAB(5) CHR$(211) STRING$(66,196) CHR$(189)
PRINT TAB(21)"Copyright (c) 1983, 84, 85, 86 Tom Mack, 10210 Oxfordshire Rd., Great Falls, VA"
DATA " If you are using RBBS-PC CPC14.1 and find it valuable, I"
DATA " suggest you consider a contribution to"
DATA ""
DATA " Capital PC Software Exchange"
DATA " Post Office Box 6128"
DATA " Silver Spring, Maryland 20906"
DATA ""
DATA " You are free to copy and share RBBS-PC CPC14.1 with"
DATA " others on these three conditions:"
DATA " 1. This program is not distributed in modified form."
DATA " 2. No fee or consideration is charged for RBBS-PC, itself."
DATA " 3. This notice is not bypassed or removed."
SUBROUTINE.PARAMETER = 8
CALL DELAYIT
END SUB
' $SUBTITLE: 'GETCOMND - subroutine to get command from command line'
' $PAGE
'
' SUBROUTINE NAME -- GETCOMND
'
' INPUT PARAMETERS -- COMMAND FROM COMMAND LINE
'
' OUTPUT PARAMETERS -- PARAMETER MEANING
' NODE.RECORD.INDEX RECORD NUMBER WITHIN THE
' MESSAGES FILE FOR THIS "NODE"
' (RANGE IS 2 TO 36)
' CONFIG.FILENAME$ NAME OF RBBS-PC ".DEF" FILE
' FOR THIS COPY RBBS-PC TO USE
'
' SUBROUTINE PURPOSE -- TO GET NODE ID FROM COMMAND LINE
'
SUB GETCOMND STATIC
'
' *****************************************************************************
' * GET NODE ID FROM COMMAND LINE *
' *****************************************************************************
'
PM$ = COMMAND$
IF LEN(PM$) = 0 THEN _
PM$ = "-"
NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1))
IF NODE.RECORD.INDEX < 2 THEN _
NODE.RECORD.INDEX = 2 : _
MID$(CONFIG.FILENAME$,5,1) = "-" : _
NODE.ID$ = "1" : _
EXIT SUB
NODE.ID$ = STR$(NODE.RECORD.INDEX-1)
MID$(CONFIG.FILENAME$,5,1) = PM$
END SUB
' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
' $PAGE
'
' SUBROUTINE NAME -- READDEF
'
' INPUT PARAMETERS -- PARAMETER MEANING
' CONFIG.FILENAME$ NAME OF RBBS-PC.DEF FILE TO READ
'
' OUTPUT PARAMETERS -- ALL THE RBBS-PC.DEF PARAMETERS
'
' SUBROUTINE PURPOSE -- TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
SUB READDEF STATIC
'
' *****************************************************************************
' * OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS *
' *****************************************************************************
'
117 OPEN "I",2,CONFIG.FILENAME$
INPUT #2,DOWNLOAD.DRIVES$, _
SYSOP.PASSWORD.1$, _
SYSOP.PASSWORD.2$, _
SYSOP.FIRST.NAME$, _
SYSOP.LAST.NAME$, _
REQUIRED.RINGS, _
START.OFFICE.HOURS, _
END.OFFICE.HOURS, _
MINUTES.PER.SESSION!, _
DF, _
DF, _
UPLOAD.DIRECTORY$, _
EXPERT.USER, _
ACTIVE.BULLETINS, _
PROMPT.BELL, _
DF, _
DF, _
MENU$(1), _
MENU$(2), _
MENU$(3), _
MENU$(4), _
MENU$(5), _
CONFERENCE.MENU$, _
DF, _
WELCOME.INTERRUPTABLE, _
REMIND.FILE.TRANSFERS, _
PAGE.LENGTH, _
MAX.MESSAGE.LINES, _
DOORS.AVAILABLE, _
DF$
INPUT #2,MAIN.MESSAGE.FILE$, _
MAIN.MESSAGE.BACKUP$, _
CALLERS.FILE$, _
COMMENTS.FILE$, _
MAIN.USER.FILE$, _
WELCOME.FILE$, _
NEWUSER.FILE$, _
DIRECTORY.EXTENTION$, _
COM.PORT$, _
BULLETINS.OPTIONAL, _
MODEM.INIT.COMMAND$, _
DF$, _
DOS.VERSION, _
FG, _
BG, _
BORDER, _
RBBS.BAT$, _
RCTTY.BAT$
INPUT #2,OMIT.MAIN.DIRECTORY$, _
OMIT.UPLOAD.DIRECTORY$, _
HELP$(1), _
HELP$(2), _
HELP$(3), _
HELP$(4), _
HELP$(5), _
HELP$(6), _
HELP$(7), _
HELP$(8), _
HELP$(9), _
BULLETIN.MENU$, _
BULLETIN.PREFIX$, _
DF$, _
MESSAGE.REMINDER, _
REQUIRE.NON.ASCII, _
DOORS.SECURITY.LEVEL, _
MAXIMUM.NUMBER.OF.NODES, _
NETWORK.TYPE, _
RECYCLE.TO.DOS, _
DF, _
DF, _
TRASHCAN.FILE$
INPUT #2,MINIMUM.LOGON.SECURITY, _
DEFAULT.SECURITY.LEVEL, _
SYSOP.SECURITY.LEVEL, _
FILESEC.FILE$, _
SYSOP.MENU.SECURITY.LEVEL, _
LOCAL.PASSWORD$, _
MAXIMUM.VIOLATIONS, _
SYSOP.FUNCTION(1), _
SYSOP.FUNCTION(2), _
SYSOP.FUNCTION(3), _
SYSOP.FUNCTION(4), _
SYSOP.FUNCTION(5), _
SYSOP.FUNCTION(6), _
SYSOP.FUNCTION(7), _
PASSWORDS.FILE$, _
MAXIMUM.PASSWORD.CHANGES, _
MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
OVERWRITE.SECURITY.LEVEL, _
DOORS.TERMINAL.TYPE, _
LIMIT.DAILY.TIME
INPUT #2,MAIN.FUNCTION(1), _
MAIN.FUNCTION(2), _
MAIN.FUNCTION(3), _
MAIN.FUNCTION(4), _
MAIN.FUNCTION(5), _
MAIN.FUNCTION(6), _
MAIN.FUNCTION(7), _
MAIN.FUNCTION(8), _
MAIN.FUNCTION(9), _
MAIN.FUNCTION(10), _
MAIN.FUNCTION(11), _
MAIN.FUNCTION(12), _
MAIN.FUNCTION(13), _
MAIN.FUNCTION(14), _
MAIN.FUNCTION(15), _
MAIN.FUNCTION(16), _
MAIN.FUNCTION(17), _
MAIN.FUNCTION(18), _
MAIN.FUNCTION(19), _
MAIN.FUNCTION(20), _
MAIN.FUNCTION(21), _
DEFAULT.MACHINE.TYPE$, _
WAIT.BEFORE.DISCONNECT
INPUT #2,FILES.FUNCTION(1), _
FILES.FUNCTION(2), _
FILES.FUNCTION(3), _
FILES.FUNCTION(4), _
FILES.FUNCTION(5), _
FILES.FUNCTION(6), _
FILES.FUNCTION(7), _
FILES.FUNCTION(8), _
FILES.FUNCTION(9), _
FILES.FUNCTION(10), _
UTILITY.FUNCTION(1), _
UTILITY.FUNCTION(2), _
UTILITY.FUNCTION(3), _
UTILITY.FUNCTION(4), _
UTILITY.FUNCTION(5), _
UTILITY.FUNCTION(6), _
UTILITY.FUNCTION(7), _
UTILITY.FUNCTION(8), _
UTILITY.FUNCTION(9), _
UTILITY.FUNCTION(10), _
UTILITY.FUNCTION(11), _
UTILITY.FUNCTION(12), _
UTILITY.FUNCTION(13), _
UTILITY.FUNCTION(14), _
UTILITY.FUNCTION(15), _
UTILITY.FUNCTION(16), _
UPLOAD.TIME.FACTOR!, _
COMPUTER.TYPE, _
REMIND.PROFILE, _
RBBS.NAME$, _
COMMANDS.BETWEEN.RINGS, _
MNP.SUPPORT, _
PAGING.PRINTER.SUPPORT$, _
MODEM.INIT.BAUD$
FOR FUNCTION.KEY.INDEX = 1 TO 12
INPUT #2,SYSOP.FUNCTION.KEY$(FUNCTION.KEY.INDEX)
NEXT
'
' *****************************************************************************
' * ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS *
' * GET DOS SUB-DIRECTORY RBBS-PC OPTIONS *
' *****************************************************************************
'
INPUT #2, DF,_
SUBDIR.COUNT,_
DF,_
UPLOAD.TO.SUBDIR,_
DF,_
UPLOAD.SUBDIR$,_
RESTRICT.BAUD,_
USE.COLOR,_
DISKFULL.GO.OFFLINE,_
EXTENDED.LOGGING,_
MODEM.RESET.COMMAND$,_
MODEM.COUNT.RINGS.COMMAND$,_
MODEM.ANSWER.COMMAND$,_
MODEM.GO.OFFHOOK.COMMAND$,_
DISK.FOR.DOS$, _
DUMB.MODEM, _
COMMENTS.AS.MESSAGES, _
LSB,_
MSB,_
LINE.CONTROL.REGISTER,_
MODEM.CONTROL.REGISTER,_
LINE.STATUS.REGISTER,_
MODEM.STATUS.REGISTER
'
' *****************************************************************************
' * ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE *
' *****************************************************************************
'
IF SUBDIR.COUNT<1 THEN _
GOTO 123
FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
INPUT #2,SUBDIR$
SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + "\"
NEXT
GOTO 125
'
' *****************************************************************************
' * SETUP DOWNLOAD DRIVES WITH NO SUBDIRECTORY SUPPORT *
' *****************************************************************************
'
123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + ":"
NEXT
SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
'
' *****************************************************************************
' * SETUP UPLOAD DRIVE AND DIRECTORY.NAME *
' *****************************************************************************
'
125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
SUBDIR.COUNT = SUBDIR.COUNT + 1
IF UPLOAD.TO.SUBDIR THEN _
SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + "\" _
ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
":"
UPLOAD.DIRECTORY$ = SUBDIR$(SUBDIR.COUNT) + _
UPLOAD.DIRECTORY$ + _
"." + _
DIRECTORY.EXTENTION$
CLOSE #2
END SUB
' $SUBTITLE: 'ANSWERIT - subroutine to answer the phone when it rings'
' $PAGE
'
' SUBROUTINE NAME -- ANSWERIT
'
' INPUT PARAMETERS -- PARAMETER MEANING
' SUBROUTINE.PARAMETER = 1 WAIT FOR PHONE TO RING
' SUBROUTINE.PARAMETER = 2 CONTINUE LOOKING FOR CONNECT
' SUBROUTINE.PARAMETER = 3 RENTRY AFTER FUNCTION KEY
' SUBROUTINE.PARAMETER = 4 GO ON LINE IMMEDIATELY
' BG LOCAL DISPLAY'S BACKGROUND
' BORDER LOCAL DISPLAY'S BORDER COLOR
' COLOR.SUPPORT ANSI.SYS SUPPORT INDICATOR
' COM.PORT$ COMMUNICATIONS PORT NAME
' COMPUTER.TYPE TYPE OF COMPUTER RUNNING ON
' DUMB.MODEM NON-HAYES TYPE MODEM FLAG
' EXTENDED.LOGGING EXTENDED CALLERS LOG FLAG
' FG LOCAL DISPLAY'S FOREGROUND
' MODEM.ANSWER.COMMAND$ COMMAND TO ANSWER PHONE
' MODEM.CONTROL.REGISTER LOCATION OF MODEM CNTRL. REG
' MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
' MODEM.INIT.BAUD$ BAUDE AT WHICH TO OPEN COMM.
' MODEM.RESET.COMMAND$ COMMAND TO RESET THE MODEM
' MODEM.STATUS.REGISTER LOCATION OF MODEM STATUS REG
' PRINTER FLAG TO PRINT ON LOCAL PRT.
' RESTRICT.BAUD FLAG TO DISALLOW 300 BAUD
' REQUIRED.RINGS NUMBER OF RINGS TO ANSWER ON
' SNOOP FLAG TO DISPLAY ON LOCAL PC
' SYSOP.NEXT FLAG TO GIVE SYSOP CONTROL
'
' OUTPUT PARAMETERS -- BAUD.TEST BAUD RATE TO SET RS232 AT
' EIGHT.BIT PARITY INDICATOR
'
' SUBROUTINE PURPOSE -- TO ANSWER THE TELEPHONE WHEN IT RINGS.
'
SUB ANSWERIT STATIC
ON ERROR GOTO 70
EC = 0
FF = SUBROUTINE.PARAMETER
SUBROUTINE.PARAMETER = 0
ON FF GOTO 201,324,245,320
'
' *****************************************************************************
' * INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS *
' *****************************************************************************
'
201 IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
WHILE(INP(MODEM.STATUS.REGISTER) AND &H40) > 0 : _
WEND : _
OUT MODEM.CONTROL.REGISTER,&H4 : _
SUBROUTINE.PARAMETER = 3 : _
CALL DELAYIT : _
OUT MODEM.CONTROL.REGISTER,&H0
210 OPEN COM.PORT$ + ":" + MODEM.INIT.BAUD$ + ",N,8,1,RS,CD,DS" AS #3
220 SUBROUTINE.PARAMETER = 1
CALL AMORPM
230 IF PRINTER THEN _
Z$ = " RBBS-PC VERSION "+VERSION.ID$+" Node "+NODE.ID$+" up at "+TIM$+" on "+DATE$ : _
CALL PRINTIT
235 EIGHT.BIT = TRUE
IF INP(MODEM.STATUS.REGISTER) > 128 THEN _
CALL READPROF : _
SUBROUTINE.PARAMETER = 1 : _
EXIT SUB
A$ = MODEM.RESET.COMMAND$
CALL MODEMPUT
IF COMPUTER.TYPE = 2 AND COM.PORT$ = "COM1" AND MODEM.STATUS.REGISTER = 1022 THEN _
SUBROUTINE.PARAMETER = 9 : _
CALL DELAYIT
SUBROUTINE.PARAMETER = 3 :
CALL DELAYIT
A$ = MODEM.INIT.COMMAND$
CALL MODEMPUT
PRINT
PRINT "READY FOR CALLS AT ";TIM$;" ON "; DATE$
PRINT
PRINT "<SCREEN CLEARS TO PREVENT BURN IN>"
PRINT
IF RESTRICT.BAUD THEN _
PRINT "300 BAUD NOT ALLOWED ";
IF COLOR.SUPPORT THEN _
PRINT "ANSI COLOR SUPPORT ACTIVE ";
IF EXTENDED.LOGGING THEN _
PRINT "EXTENDED CALLER LOGGING"
PRINT
IF REQUIRED.RINGS = 0 THEN PRINT "WAITING FOR CARRIER"
IF REQUIRED.RINGS = 255 THEN PRINT "RING BACK SYSTEM SPECIFIED"
IF REQUIRED.RINGS > 0 AND _
REQUIRED.RINGS < 255 THEN _
PRINT "WAITING FOR RING ";REQUIRED.RINGS
'
' *****************************************************************************
' * GET READY TO ANSWER INCOMMING CALL: *
' * 1. LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC. *
' * REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND. *
' * 2. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS. *
' * REQUIRED RINGS > 0 AND S0 = 0 IN MODEM INIT COMMAND. *
' * 3. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER *
' * FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK). *
' * REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND. *
' *****************************************************************************
'
CALL FINDTIME (TCA!)
SUBROUTINE.PARAMETER = 1
CALL LINE25
QQ = 255
I = INSTR(MODEM.INIT.COMMAND$,"S0")
IF I = 0 THEN _
GOTO 239
IF VAL(MID$(MODEM.INIT.COMMAND$,I+3,3)) = 255 THEN _
QQ = 0 : _
BLK = QQ
239 RINGBACK.WAIT.STARTED! = 0
IF REQUIRED.RINGS > 0 AND QQ=0 THEN _
CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
COLOR 7,0,0 _
ELSE COLOR FG,BG,BORDER
240 IF SYSOP.NEXT THEN _
SUBROUTINE.PARAMETER = 3 : _
EXIT SUB
'
' *****************************************************************************
' * WAIT FOR INCOMING CALLS *
' *****************************************************************************
'
245 WHILE INP(MODEM.STATUS.REGISTER) < 128
CALL FINDFUNC
IF FUNCTION.KEY >0 THEN _
SUBROUTINE.PARAMETER = 6 : _
EXIT SUB
250 IF KEY.PRESSED$ = ESCAPE$ THEN _
SUBROUTINE.PARAMETER = 3 : _
EXIT SUB
260 IF RINGBACK.WAIT.STARTED! > 0 THEN _
CALL FINDTIME (TI!) : _
IF TI! - RINGBACK.WAIT.STARTED! > 45 THEN _
RINGBACK.WAIT.STARTED! = 0 : _
RING.BACK.COUNT = 0 : _
Q = 0 : _
IF (SNOOP AND REQUIRED.RINGS) THEN _
PRINT "Ringback timeout";PAGING.PRINTER.SUPPORT$ : _
IF BLK THEN _
QQ = 0 _
ELSE QQ = 255
265 CALL FINDTIME (TI!)
IF TI! - TCA! > 120 THEN _
LOCATE ,,0 : _
CLS : _
CALL FINDTIME (TCA!)
266 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
REQUIRED.RINGS > 0 THEN _
GOTO 275
270 WEND
IF REQUIRED.RINGS = 0 THEN _
GOTO 321
'
' *****************************************************************************
' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 0) OR *
' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) -- *
' * "RING BACK." *
' *****************************************************************************
'
275 ON ERROR GOTO 70
IF LOC(3) THEN _
X$ = INPUT$(LOC(3),3)
A$ = MODEM.COUNT.RINGS.COMMAND$
CALL MODEMPUT
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
290 X$ = INPUT$(LOC(3),3)
IF LEN(X$) = 0 THEN _
X$=STR$(RING.BACK.COUNT)
A$ = ""
IF QQ = 0 AND Q < VAL(X$) THEN _
Q = VAL(X$) : _
GOTO 305
300 RING.BACK.COUNT = RING.BACK.COUNT + 1
A$ = STR$(RING.BACK.COUNT)
IF QQ = 0 THEN _
RING.BACK.COUNT = VAL(X$) : _
A$ = STR$(RING.BACK.COUNT)
305 IF SNOOP THEN _
PRINT TIME$ + " Ring " + A$ + PAGING.PRINTER.SUPPORT$
310 IF RING.BACK.COUNT < REQUIRED.RINGS THEN _
GOTO 239
320 A$ = MODEM.ANSWER.COMMAND$
CALL MODEMPUT
'
' *****************************************************************************
' * TEST FOR CARRIER PRESENT *
' *****************************************************************************
'
321 CALL FINDTIME (CONNECT.DELAY!)
CONNECT.DELAY! = CONNECT.DELAY! + 30
MODEM.RESPONSE$ = ""
322 CALL FINDTIME (TI!)
IF INP(MODEM.STATUS.REGISTER) < 128 AND TI! < CONNECT.DELAY! THEN _
GOTO 322
IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
SUBROUTINE.PARAMETER = 4 : _
EXIT SUB
SUBROUTINE.PARAMETER = 3 :
CALL DELAYIT
324 ON ERROR GOTO 70
MODEM.RESPONSE$ = MODEM.RESPONSE$ + INPUT$(LOC(3),3)
PRINT MODEM.RESPONSE$
CALL FINDTIME (TI!)
IF TI! > CONNECT.DELAY! THEN _
Z$ = "Connect timeout" : _
SUBROUTINE.PARAMETER = 1 : _
CALL UPDTCALR : _
SUBROUTINE.PARMETER = 4 : _
EXIT SUB
325 IF DUMB.MODEM THEN _
BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
GOTO 326
IF INSTR(MODEM.RESPONSE$,"CONNECT") THEN _
BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"CONNECT") + 8,4)) : _
GOTO 326
GOTO 324
326 SUBROUTINE.PARAMETER = 2
327 ON ERROR GOTO 0
EXIT SUB
328 ON ERROR GOTO 70
LINE.STATUS = INP(LINE.STATUS.REGISTER)
IF RET.ERL = 275 THEN _
GOTO 275
GOTO 324
END SUB
' $SUBTITLE: 'LINE25 - subroutine to build/display RBBS-PCs line 25'
' $PAGE
'
' SUBROUTINE NAME -- LINE25
'
' INPUT PARAMETERS -- PARAMETER MEANING
' SUBROUTINE.PARAMETER = 1 BUILD DISPLAY FOR LINE 25
' SUBROUTINE.PARAMETER = 2 UPDATE LINE 25
' LOCK.STATUS$ STATUS OF LOCKS IN A MULTI-
' USER ENVIRONMENT OR TIME OF
' DAY USER LOGGED ON OR THE
' RE-CYCLED
'
' OUTPUT PARAMETERS -- CURSOR.LINE CURRENT LINE ON SCREEN
' CURSOR.ROW CURRENT ROW ON CURSOR.LINE
'
' SUBROUTINE PURPOSE -- TO BUILD OR UPDATE RBBS-PC'S LINE 25 DISPLAYED
' ON THE PC SCREEN THAT IS RUNNING RBBS-PC.
'
SUB LINE25 STATIC
ON SUBROUTINE.PARAMETER GOTO 949,950
'
' *****************************************************************************
' * BUILD LINE 25 DISPLAY *
' *****************************************************************************
'
949 LINE.25$ = MID$(" AVL ",1-4*SYSOP.AVAILABLE,4) + _
MID$(" ANY ",1-4*SYSOP.ANNOY,4) + _
MID$(" LPT ",1-4*PRINTER,4) + _
MID$("SYS",1,-3*SYSOP.NEXT)
'
' *****************************************************************************
' * LINE 25 UPDATE ROUTINE *
' *****************************************************************************
'
950 IF NOT SNOOP THEN _
EXIT SUB
CURSOR.LINE = CSRLIN
CURSOR.ROW = POS(0)
HH = LEN(ACTIVE.USER.NAME$) + LEN(CI$) + LEN(LINE.25$) + 18
LOCATE 25,1
IF NETWORK.TYPE = 0 THEN _
LOCK.STATUS$ = SPACE$(3)+TIME.LOGGED.ON$
IF HH>79 THEN _
HH=78
PRINT LINE.25$+SPACE$(79-HH)+STR$(USER.SECURITY.LEVEL)+" "+ACTIVE.USER.NAME$+" "+CI$+" "+LOCK.STATUS$;
LOCATE CURSOR.LINE,CURSOR.ROW
END SUB
' $SUBTITLE: 'TPUT -- RBBS-PC common routine to write to comm. port'
' $PAGE
'
' SUBROUTINE NAME -- TPUT (TERMINAL PUT)
'
' INPUT PARAMETERS -- PARAMETER MEANING
' A$ STRING TO WRITE TO THE
' COMMUNICATIONS PORT
' SUBROUTINE.PARAMETER = 1 SKIP A LINE BEFORE WRITING
' TO THE COMMUNICATIONS PORT
' SUBROUTINE.PARAMETER = 2 SKIP A LINE BEFORE WRITING
' TO THE COMMUNICATIONS PORT
' AND THEN SKIP TWO LINES
' AFTER WRITING TO THE COMM-
' UNICATIONS PORT
' SUBROUTINE.PARAMETER = 3 WRITE TO THE COMMUNICATIONS
' PORT AND THEN SKIP TWO
' LINES
' SUBROUTINE.PARAMETER = 4 WRITE TO THE COMMUNICATIONS
' PORT WITHOUT A CR/LF
' SUBROUTINE.PARAMETER = 5 WRITE TO THE COMMUNICATIONS
' PORT WITH A CR/LF
' SUBROUTINE.PARAMETER = 6 RESET EVERYTHING FOR INPUT
' STRING
' SUBROUTINE.PARAMETER = 7 RE-ENTRY AFTER HANDLING A
' FUNCTION KEY
'
' OUTPUT PARAMETERS -- SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
' FUNCTION.KEY <> 0 FUNCTION KEY PRESSED
'
' SUBROUTINE PURPOSE -- COMMON OUTPUT ROUTINE FOR RBBS-PC TO THE
' COMMUNICATIONS PORT (TERMINAL PUT)
SUB TPUT STATIC
HALT.IT = 0
IF SUBROUTINE.PARAMETER <> 7 THEN _
PARM = SUBROUTINE.PARAMETER
ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
'
' *****************************************************************************
' * COMMON OUTPUT ROUTINE *
' *****************************************************************************
'
1398 CALL SKIPLINE
GOTO 1405
1399 CALL SKIPLINE
1400 CR = 1
1403 CR = CR + 1
1405 RET = FALSE
IF NOT STOP.INTERRUPTS OR CM OR INP(MODEM.STATUS.REGISTER) <128 THEN _
GOTO 1435
1410 CALL FINDFUNC
IF FUNCTION.KEY <> 0 THEN _
EXIT SUB
1411 Y$ = KEY.PRESSED$
SUBROUTINE.PARAMETER = PARM
IF LOCAL.USER THEN _
GOTO 1430
IF EOF(3) THEN _
CALL CARRIER : _
IF SUBROUTINE.PARAMETER = -1 THEN _
EXIT SUB ELSE _
GOTO 1430
1419 ON ERROR GOTO 75
1420 Y$ = INPUT$(1,3)
1425 ON ERROR GOTO 0
IF SUBROUTINE.PARAMETER = -1 THEN _
EXIT SUB
IF Y$ = XOFF$ THEN _
WHILE EOF(3) : _
CALL CARRIER : _
IF SUBROUTINE.PARAMETER = -1 THEN _
EXIT SUB ELSE _
WEND : _
GOTO 1419
1430 IF Y$ = CHR$(11) AND STOP.INTERRUPTS THEN _
GOTO 1475
IF Y$ = CANCEL$ AND STOP.INTERRUPTS THEN _
GOTO 1475
1435 IF NOT SNOOP THEN _
GOTO 1437
LOCATE ,,1
IF COLOR.SUPPORT AND A$ <> "" THEN _
CALL ANSI(A$,C.C,C.L) : _
LOCATE C.C,C.L : _
GOTO 1437
CURSOR.ROW = 1
WHILE CURSOR.ROW <= LEN(A$)
CURSOR.LINE = CURSOR.ROW + _
INSTR(MID$(A$,CURSOR.ROW) + _
CARRIAGE.RETURN$,CARRIAGE.RETURN$) - 2
PRINT MID$(A$,CURSOR.ROW,CURSOR.LINE-CURSOR.ROW + 1); _
MID$(LINE.FEED$,1,-(CURSOR.LINE < LEN(A$)));
CURSOR.ROW = CURSOR.LINE + LEN(RETURN.LINE.FEED$) + 2
WEND
1437 IF LOCAL.USER THEN _
GOTO 1450
IF UPPER.CASE THEN _
CALL ALLCAPS (A$)
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,A$;
1450 IF CR <> 1 THEN _
CALL SKIPLINE _
ELSE IF CR > 1 THEN _
CALL SKIPLINE
1470 Y$ = ""
A$ = Y$
CR = 0
IF HALT.IT = 0 THEN _
EXIT SUB
STOP.INTERRUPTS = RET
RET = TRUE
NON.STOP = FALSE
EXIT SUB
1475 CR = 2
A$ = ""
RET = STOP.INTERRUPTS
STOP.INTERRUPTS = FALSE
HALT.IT = 1
GOTO 1410
1476 ON ERROR GOTO 0
EXIT SUB
1477 ON ERROR GOTO 75
LINE.STATUS = INP(LINE.STATUS.REGISTER)
IF RET.ERR = 57 THEN _
GOTO 1425
GOTO 1476
END SUB
' $SUBTITLE: 'SKIPLINE - subroutine to write a blank line to user'
' $PAGE
'
' SUBROUTINE NAME -- SKIPLINE
'
' INPUT PARAMETERS -- PARAMETER MEANING
' LOCAL.USER
' MODEM.STATUS.REGISTER
' RETURN.LINE.FEED$
' SNOOP
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- SKIP A LINE ON THE USER'S TERMINAL
'
SUB SKIPLINE STATIC
1485 IF SNOOP THEN _
PRINT
IF NOT LOCAL.USER AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,RETURN.LINE.FEED$;
END SUB
' $SUBTITLE: 'SETCRLF -- subroutine to set up nulls/lf's for output'
' $PAGE
'
' SUBROUTINE NAME -- SETCRLF
'
' INPUT PARAMETERS -- PARAMETER MEANING
' CARRIAGE.RETURN$ CARRIAGE RETURN CHARACTER
' CI$ CITY/STATE OF CALLER
' LINE.FEED$ LINE FEED CHARACTER
' LINE.FEEDS LINE FEED SWITCH
' NUL$ NULL CHARACTER
'
' OUTPUT PARAMETERS -- RETURN.LINE.FEED$ END-OF-LINE STRING
'
' SUBROUTINE PURPOSE -- SET UP THE NECESSARCY NULLS/LINE FEEDS TO END
' EACH OUTPUT TO THE COMMUNICATIONS PORT WITH
'
SUB SETCRLF STATIC
1496 RETURN.LINE.FEED$ = MID$(CARRIAGE.RETURN$,1,-(CI$ <> "LOCAL")) + _
NUL$ + _
MID$(LINE.FEED$,1,-LINE.FEEDS)
END SUB
' $SUBTITLE: 'TGET -- RBBS-PC common routine to ask a user a question'
' $PAGE
'
' SUBROUTINE NAME -- TGET
'
' INPUT PARAMETERS -- PARAMETER MEANING
' SUBROUTINE.PARAMETER = 1 STANDARD ENTRY
' SUBROUTINE.PARAMETER = 2 ENTRY AFTER A FUNCTION KEY
' HAS BEEN HANDLED
' A$ STRING TO WRITE TO THE
' COMMUNICATIONS PORT
'
' OUTPUT PARAMETERS -- SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
' B$ STRING THAT WAS ENTERED
' Q NUMBER OF PARAMETERES THAT
' WERE ENTERED WHICH WHERE
' SEPERATED BY A SEMICOLON
' B$() STRING MATRIX WITH EACH
' ITEM CONTAIN THE STRING
' THAT WAS ENTERED BETWEEN
' SEMICOLONS.
' FUNCTION.KEY <> 0 FUNCTION KEY PRESSED
' YES REPLY IS "Y" OR "YES"
' NO REPLY IS "N" OR "NO"
' NON.STOP REPLY IS "NS" OR "ns"
' KILL.MESSAGE REPLY IS "K"
' REPLY REPLY IS "RE"
'
' SUBROUTINE PURPOSE -- COMMON ROUTINE TO ASK A USER A QUESTION
'
SUB TGET STATIC
ON SUBROUTINE.PARAMETER GOTO 1500,1526
'
' *****************************************************************************
' * COMMON INPUT ROUTINE *
' *****************************************************************************
'
1500 CALL CARRIER
IF SUBROUTINE.PARAMETER = -1 THEN _
EXIT SUB
TOA! = FRE("A")
CALL FINDTIME (AUTO.LOGOFF!)
AUTO.LOGOFF! = AUTO.LOGOFF! + WAIT.BEFORE.DISCONNECT
A = 0
B = 0
C = 0
Q = 1
EOL = FALSE
YES = FALSE
B$ = ""
NO = FALSE
A$ = A$ + "? "
SUBROUTINE.PARAMETER = 4
CALL TPUT
IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
EXIT SUB
IF LOCAL.USER THEN _
LINE INPUT "",B$ : _
GOTO 1575
IF PROMPT.BELL AND INP(MODEM.STATUS.REGISTER) >127 THEN _
PRINT #3,CHR$(7);
1525 WHILE EOF(3)
CALL CARRIER
IF SUBROUTINE.PARAMETER = -1 THEN _
EXIT SUB
CALL FINDTIME (TI!)
IF TI! > AUTO.LOGOFF! THEN _
SUBROUTINE.PARAMETER = -1 : _
EXIT SUB
CALL FINDFUNC
IF FUNCTION.KEY <> 0 THEN _
EXIT SUB
1526 Y$ = KEY.PRESSED$
IF Y$ <> "" THEN _
GOTO 1545
WEND
CALL CARRIER
IF SUBROUTINE.PARAMETER = -1 THEN _
EXIT SUB
ON ERROR GOTO 80
1540 Y$ = INPUT$(1,3)
ON ERROR GOTO 0
IF TEST.PARITY THEN _
GOTO 1541 _
ELSE IF Y$ = CHR$(127) THEN _
GOTO 1635 _
ELSE GOTO 1545
1541 IF ASC(Y$) = 141 THEN _
OUT LINE.CONTROL.REGISTER,&H1A : _
EIGHT.BIT = FALSE : _
TEST.PARITY = FALSE : _
GR = FALSE
Y$ = CHR$(ASC(Y$) AND 127)
1545 IF Y$ = CHR$(8) OR _
Y$ = CHR$(7) OR _
Y$ = CHR$(26) OR _
Y$ = CHR$(227) THEN _
GOTO 1635
IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
GOTO 1525
IF Y$ = "^" THEN _
GOTO 1525
IF SNOOP THEN _
PRINT Y$;
IF NOT HIDDEN AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,Y$; _
ELSE IF INP(MODEM.STATUS.REGISTER) > 127 THEN_
PRINT #3,".";
IF Y$ = CARRIAGE.RETURN$ THEN _
GOTO 1570
IF LEN(B$) >= 254 THEN _
A$ = "Input too long!" : _
SUBROUTINE.PARAMETER = 5 : _
CALL TPUT : _
IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
EXIT SUB _
ELSE GOTO 1500
B$ = B$ + Y$
GOTO 1525
1570 IF LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,LINE.FEED$;
1575 A = INSTR(B$,";")
IF A = 0 THEN _
GOTO 1620
B$(1) = LEFT$(B$,A-1)
A = A + 1
1585 B = INSTR(A,B$,";")
C = B-A
IF C < 1 THEN _
EOL = TRUE : _
C = 128
DF$ = MID$(B$,A,C)
IF DF$ <> "" THEN _
Q = Q + 1 : _
B$(Q) = DF$
IF NOT EOL AND Q < 10 THEN _
A = B + 1 : _
GOTO 1585
IF LEN(B$) > 64 THEN _
A$ = "Try again, " + FIRST.NAME$ : _
SUBROUTINE.PARAMETER = 5 : _
CALL TPUT : _
IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
EXIT SUB _
ELSE GOTO 1500
GOTO 1625
1620 B$(1) = B$
Q = 1
IF B$ = "" THEN _
Q = 0 : _
EXIT SUB
1625 CALL ALLCAPS (B$)
IF LEFT$(B$,1) = "Y" THEN _
YES = TRUE _
ELSE IF LEFT$(B$,1) = "N" THEN _
NO = TRUE
IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
NO = FALSE : _
NON.STOP = TRUE : _
B$(Q) = "" : _
IF Q > 1 THEN _
Q = Q-1
IF B$ = "RE" AND USER.SECURITY.LEVEL >= MAIN.FUNCTION(4) THEN _
REPLY = TRUE : _
EXIT SUB
IF B$ = "K" AND USER.SECURITY.LEVEL >= MAIN.FUNCTION(10) THEN _
KILL.MESSAGE = TRUE
EXIT SUB
1635 IF LEN(B$) = 0 THEN _
GOTO 1525
B$ = LEFT$(B$,LEN(B$)-1)
IF SNOOP THEN _
PRINT BACK.ARROW$;
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
PRINT #3,BACKSPACE$;
GOTO 1525
1650 ON ERROR GOTO 80
LINE.STATUS = INP(LINE.STATUS.REGISTER)
GOTO 1540
1651 ON ERROR GOTO 0
END SUB
' $SUBTITLE: 'SETBAUD - subroutine to set the baud rate in the RS232'
' $PAGE
'
' SUBROUTINE NAME -- SETBAUD
'
' INPUT PARAMETERS -- PARAMETER MEANING
' BAUD.RATE.DIVISOR NUMBER TO DIVIDE THE 8250 CHIP'S
' PROGRAMABLE CLOCK TO ADJUST THE
' BAUD RATE TO THE USER'S BAUD
' RATE (INDEPENDENT OF THE BAUD
' RATE USED TO OPEN THE COMM. PORT)
'
' DESIRED BAUD DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
' RATE PCjr PC AND XT
' 50 2237 2304
' 75 1491 1536
' 110 1017 1047
' 134.5 832 857
' 150 746 768
' 300 373 384
' 600 186 192
' 1200 93 96
' 1800 62 64
' 2000 56 58
' 2400 47 48
' 3600 31 32
' 4800 23 24
' 7200 not available 16
' 9600 not available 12
'
' OUTPUT PARAMETERS -- BAUD RATE SET IN THE RS232 INTERFACE
'
' SUBROUTINE PURPOSE -- TO SET THE BAUD RATE IN THE RS232 INTERFACE
' INDEPENDENT OF THE BAUD RATE THE COMMUNICATIONS PORT
' WAS OPENED AT
'
SUB SETBAUD STATIC
'
' *****************************************************************************
' * BAUD RATE CHANGE ROUTINE *
' *****************************************************************************
'
1654 LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER)
MSB.SAVE = INP(MSB)
OUT MSB,0
OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128
MOST.SIGNIFICANT.BYTE = FIX (BAUD.RATE.DIVISOR / 256)
LEAST.SIGNIFICANT.BYTE = BAUD.RATE.DIVISOR - (MOST.SIGNIFICANT.BYTE * 256)
OUT LSB,LEAST.SIGNIFICANT.BYTE
OUT MSB,MOST.SIGNIFICANT.BYTE
OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS
OUT MSB,MSB.SAVE
END SUB
' $SUBTITLE: 'LOGERROR - subroutine to log errors to CALLERS file'
' $PAGE
'
' SUBROUTINE NAME -- LOGERROR
'
' INPUT PARAMETERS -- PARAMETER MEANING
' ERR ERROR NUMBER DETECTED BY BASIC
' ERL LAST LINE NUMBER ENCOUNTERED
' PRIOR TO ENCOUNTERNING ERROR
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO SET UP A STRING TO WRITE TO THE CALLERS LOG
' INDICATING THE DATE, TIME, ERROR, AND ERROR LINE
'
SUB LOGERROR STATIC
13660 A$ = "+++ Error " + _
STR$(ERR) + _
" line " + _
STR$(ERL) + _
" at " + _
TIME$ + _
" on " + _
DATE$
Z$ = A$
SUBROUTINE.PARAMETER = 2
CALL UPDTCALR
END SUB
' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
' $PAGE
'
' SUBROUTINE NAME -- UPDTCALR
'
' INPUT PARAMETERS -- PARAMETER MEANING
' Z$ MESSAGE TO GO IN CALLER LOG
' SUBROUTINE.PARAMETER = 1 CHECK FOR EXTENDED LOGGING
' BEFORE UPDATING.
' SUBROUTINE.PARAMETER = 2 UPDATE CALLER LOG WITH Z$
'
' OUTPUT PARAMETERS -- CURRENT.DATE$ CURRENT DATE (MM-DD-YY)
' TIM$ CURRENT TIME (I.E. 1:13 PM)
' TIME.LOGGEND.ON$ TIME USER LOGGED ON (HH:MM:SS)
'
' SUBROUTINE PURPOSE -- TO UPDATE THE CALLER'S FILE AND/OR PRINT ON THE
' LOCAL PRINTER IF IT IS ENABLED
'
SUB UPDTCALR STATIC
ON SUBROUTINE.PARAMETER GOTO 13665,13670
'
' *****************************************************************************
' * EXTENDED LOGGING ENTRY *
' *****************************************************************************
'
13665 IF NOT EXTENDED.LOGGING THEN _
EXIT SUB
SUBROUTINE.PARAMETER = 2
CALL AMORPM
Z$ = Z$ + " at " + TIM$
'
' *****************************************************************************
' * UPDATE CALLERS FILE WITH USER ACTIVITY *
' *****************************************************************************
'
13670 Z$ = SPACE$(5) + Z$
IF NOT LOCAL.USER THEN _
LSET CALLERS.RECORD$ = Z$ : _
CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1 : _
PUT 4,CALLERS.FILE.INDEX
CALL PRINTIT
END SUB
' $SUBTITLE: 'PRINTIT - subroutine to print on the local PC's printer'
' $PAGE
'
' SUBROUTINE NAME -- PRINTIT
'
' INPUT PARAMETERS -- PARAMETER MEANING
' Z$ STRING TO WRITE TO THE PRINTER
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO WRITE TO THE PRINTER ATTACHED TO THE PC RUNNING
' RBBS-PC AND TOGGLE THE PRINTER SWTICH OFF WHENEVER
' THE PRINTER IS/BECOMES UNAVAILABLE
'
SUB PRINTIT STATIC
ON ERROR GOTO 65
13674 IF PRINTER THEN _
LPRINT Z$
ON ERROR GOTO 0
END SUB
' $SUBTITLE: 'FINDIT - subroutine to find if a file exists'
' $PAGE
'
' SUBROUTINE NAME -- FINDIT
'
' INPUT PARAMETERS -- PARAMETER MEANING
' FILE.NAME$ NAME OF FILE TO FIND
'
' OUTPUT PARAMETERS -- OK TRUE IF FILE EXISTS
' EC ERROR CODE
'
' SUBROUTINE PURPOSE -- DETERMINE IF A FILE EXISTS BY RENAMING IT TO ITSELF
'
SUB FINDIT STATIC
ON ERROR GOTO 85
EC = 0
OK = FALSE
20221 NAME FILE.NAME$ AS FILE.NAME$
20222 ON ERROR GOTO 85
CLOSE 2
20223 OPEN FILE.NAME$ FOR INPUT AS #2
OK = TRUE
20224 ON ERROR GOTO 0
END SUB
' $SUBTITLE: 'BADNAME - subroutine to find bad file names'
' $PAGE
'
' SUBROUTINE NAME -- BADNAME
'
' INPUT PARAMETERS -- PARAMETER MEANING
' ACTIVE.MESSAGE.FILE$
' ACTIVE.USER.FILE$
' CALLERS.FILE$
' COMMENTS.FILE$
' MAIN.MESSAGE.BACKUP$
' MAIN.MESSAGE.FILE$
' MAXIMUM.VIOLATIONS
' PASSWORDS.FILE$
' RBBS.BAT$
' RCTTY.BAT$
' SUBDIR$()
' SUBDIR.INDEX
' VIOLATION$
' VIOLATIONS.THIS.SESSION
' Z$ NAME OF FILE
'
' OUTPUT PARAMETERS -- BAD.FILE.NAME.INDEX 1 = FILE NAME IS OK
' 2 = SECURITY BREACH TRIED
' VIOLATIONS.THIS.SESSION NUMBER OF VIOLATIONS
' FILENAME$ NAME OF FILE
'
' SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
' TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
' SECURITY
'
SUB BADNAME STATIC
'
' *****************************************************************************
' * TEST FOR SYSTEM FILE ATTEMPT *
' *****************************************************************************
'
20235 BAD.FILE.NAME.INDEX = 1
Z$ = FILE.NAME$
IF INSTR(3,FILE.NAME$,MID$(ACTIVE.MESSAGE.FILE$,3,(LEN(ACTIVE.MESSAGE.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$,3,(LEN(ACTIVE.USER.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$+".BAK",3,(LEN(ACTIVE.USER.FILE$+".BAK")-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(CALLERS.FILE$,3,(LEN(CALLERS.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(COMMENTS.FILE$,3,(LEN(COMMENTS.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(FILESEC.FILE$,3,(LEN(FILESEC.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.BACKUP$,3,(LEN(MAIN.MESSAGE.BACKUP$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.FILE$,3,(LEN(MAIN.MESSAGE.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$,3,(LEN(MAIN.USER.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$+".BAK",3,(LEN(MAIN.USER.FILE$+".BAK")-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(PASSWORDS.FILE$,3,(LEN(PASSWORDS.FILE$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(RBBS.BAT$,3,(LEN(RBBS.BAT$)-2))) THEN _
GOTO 20236
IF INSTR(3,FILE.NAME$,MID$(RCTTY.BAT$,3,(LEN(RCTTY.BAT$)-2))) THEN _
GOTO 20236
EXIT SUB
20236 BAD.FILE.NAME.INDEX = 2
END SUB
' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
' $PAGE
'
' SUBROUTINE NAME -- BADFILE
'
' INPUT PARAMETERS -- PARAMETER MEANING
' VIOLATION$
' VIOLATIONS.THIS.SESSION
' Z$ NAME OF FILE
'
' OUTPUT PARAMETERS -- BAD.FILE.NAME.INDEX 1 = FILE NAME IS OK
' 2 = CHARACTER NOT ALLOWED
' 3 = SYSTEM CRASH ATTEMPT
' VIOLATIONS.THIS.SESSION NUMBER OF VIOLATIONS
' FILENAME$ NAME OF FILE
'
' SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
' TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
' SECURITY
'
SUB BADFILE STATIC
'
' *****************************************************************************
' * TEST FOR INVALID CHARACTERS IN FILENAME *
' *****************************************************************************
'
20741 BAD.FILE.NAME.INDEX = 1
CALL ALLCAPS (Z$)
FILE.NAME$ = SUBDIR$(SUBDIR.INDEX) + Z$
IF INSTR(FILE.NAME$,"?") OR _
INSTR(FILE.NAME$,"*") OR _
INSTR(FILE.NAME$," ") OR _
INSTR(3,FILE.NAME$,":") OR _
INSTR(FILE.NAME$,".DEF") OR _
INSTR(FILE.NAME$,".OLD") OR _
MID$(FILE.NAME$,LEN(FILE.NAME$),1) = "." THEN _
BAD.FILE.NAME.INDEX = 2 : _
EXIT SUB
IF LEN(Z$) >= 3 THEN _
IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:PRN:CON:AUX",Z$) THEN _
VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS : _
VIOLATION$ = VIOLATION$ + Z$ : _
BAD.FILE.NAME.INDEX = 3
END SUB
' $SUBTITLE: 'FILELOCK - subroutine to share RBBS-PC files'
' $PAGE
'
' SUBROUTINE NAME -- FILELOCK
'
' INPUT PARAMETERS -- PARAMETER MEANING
' SUBROUTINE.PARAMETER = 1 UNLOCK USERS AND MESSAGES
' 2 FLUSH MESSAGE RECORD TO DISK
' AND UNLOCK MESSAGES
' 3 LOCK MESSAGE FILE
' 4 UNLOCK MESSAGE FILE
' 5 LOCK USER FILE
' 6 LOCK 4 RECORD BLOCK IN USER
' FILE
' 7 UNLOCK USER FILE
' 8 UNLOCK 4 RECORD BLOCK IN USER
' FILE
' 9 LOCK UPLOAD DIRECTORY OR
' COMMENTS FILE
' 10 UNLOCK UPLOAD DIRECTORY OR
' COMMENTS FILE
' ACTIVE.MESSAGE FILE$ NAME OF MESSAGE FILE
' ACTIVE.USER.FILE$ NAME OF USER FILE
' CONFIG.FILE.NAME$ FILE NAME TO FLUSH RECORD FROM
' EN$ UPLOAD DIRECTORY OR COMMENTS
' FILE NAME TO LOCK/UNLOCK
' NETWORK.TYPE TYPE OF NETWORK LOCKING TO USE
'
' OUTPUT PARAMETERS -- SUBROUTINE.PARAMETER = -1 TERMINATE RBBS-PC IMMEDATELY
' BLK
' LOCK.DRIVE
' LOCK.FILE.NAME$
' LOCK.STATUS$
' MESSAGE.FILE.LOCK
' USER.BLOCK.LOCK
' USER.FILE.LOCK
' USER.FILE.INDEX
'
' SUBROUTINE PURPOSE -- TO LOCK AND UNLOCK THE SHARED RBBS-PC FILES WHEN
' MULTIPLE COPIES OF RBBS-PC ARE SHARING THE SAME
' FILES IN EITHER A MULTI-TASKING DOS ENVIRONMENT OR
' IN A LOCAL AREA NETWORK ENVIRONMENT
'
SUB FILELOCK STATIC
ON SUBROUTINE.PARAMETER GOSUB 21995,21996,22000,25000,26000,26500,27000,_
27500,29000,29500
EXIT SUB
'
' *****************************************************************************
' * UNLOCK USERS AND MESSAGES *
' *****************************************************************************
'
21995 GOSUB 27000
GOSUB 25000
RETURN
'
' *****************************************************************************
' * FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1 *
' *****************************************************************************
'
21996 CLOSE 1
IF SHARE.IT THEN _
OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
ELSE OPEN "I",1,CONFIG.FILENAME$
CLOSE 1
'
' *****************************************************************************
' * UNLOCK MESSAGES *
' *****************************************************************************
'
GOSUB 25000
RETURN
'
' *****************************************************************************
' * LOCK MESSAGE FILE *
' *****************************************************************************
'
22000 MESSAGE.FILE.LOCK = TRUE
MID$(LOCK.STATUS$,1,2) = "LM"
SUBROUTINE.PARAMETER = 2
CALL LINE25
LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
ON NETWORK.TYPE GOTO 22100,22200,22300
RETURN
'
' *****************************************************************************
' * LOCK MESSAGE FILE (MULTI-LINK) *
' *****************************************************************************
'
22100 AX = &H0
BX = &H1
CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * LOCK MESSAGE FILE (OMNINET) *
' *****************************************************************************
'
22200 CC$ = CHR$(1) + MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 0 THEN _
RETURN
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
GOTO 22200
'
' *****************************************************************************
' * LOCK MESSAGE FILE (ORCHID PC-NET) *
' * LOCK USER FILE (ORCHID PC-NET) *
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET) *
' *****************************************************************************
'
22300 GOSUB 28100
CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
RETURN
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE *
' *****************************************************************************
'
25000 MESSAGE.FILE.LOCK = FALSE
MID$(LOCK.STATUS$,1,2) = "UM"
SUBROUTINE.PARAMETER = 2
CALL LINE25
LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
ON NETWORK.TYPE GOTO 25100,25200,25300
RETURN
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE (MULTI-LINK) *
' *****************************************************************************
'
25100 AX = &H100
BX = &H1
CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE (OMNINET) *
' *****************************************************************************
'
25200 CC$ = CHR$(17) + MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 128 THEN _
RETURN
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
GOTO 25200
'
' *****************************************************************************
' * UNLOCK MESSAGE FILE (ORCHID PC-NET) *
' * UNLOCK USER FILE (ORCHID PC-NET) *
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET) *
' *****************************************************************************
'
25300 GOSUB 28100
CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
RETURN
'
' *****************************************************************************
' * LOCK USER FILE *
' *****************************************************************************
'
26000 USER.FILE.LOCK = TRUE
MID$(LOCK.STATUS$,4,2) = "LU"
SUBROUTINE.PARAMETER = 2
CALL LINE25
LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
ON NETWORK.TYPE GOTO 26100,26200,22300
RETURN
'
' *****************************************************************************
' * LOCK USER FILE (MULTI-LINK) *
' *****************************************************************************
'
26100 AX = &H0
BX = &H2
CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * LOCK USER FILE (OMNINET) *
' *****************************************************************************
'
26200 CC$ = CHR$(1) + MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 0 THEN _
RETURN
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
GOTO 26200
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE *
' *****************************************************************************
'
26500 USER.BLOCK.LOCK = TRUE
BLK = (USER.FILE.INDEX / 4) + .26
MID$(LOCK.STATUS$,7,2) = "LB"
SUBROUTINE.PARAMETER = 2
CALL LINE25
ON NETWORK.TYPE GOTO 26600,26700,26800
RETURN
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) *
' *****************************************************************************
'
26600 AX = &H0
BX = BLK + 10
CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE (OMNINET) *
' *****************************************************************************
'
26700 CC$ = CHR$(1) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
GOSUB 28000
IF CT = 0 THEN _
RETURN
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
GOTO 26700
'
' *****************************************************************************
' * LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET) *
' *****************************************************************************
'
26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
GOTO 22300
'
' *****************************************************************************
' * UNLOCK USER FILE *
' *****************************************************************************
'
27000 USER.FILE.LOCK = FALSE
MID$(LOCK.STATUS$,4,2) = "UU"
SUBROUTINE.PARAMETER = 2
CALL LINE25
LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
ON NETWORK.TYPE GOTO 27100,27200,25300
RETURN
'
' *****************************************************************************
' * UNLOCK USER FILE (MULTI-LINK) *
' *****************************************************************************
'
27100 AX = &H100
BX = &H2
CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * UNLOCK USER FILE (OMNINET) *
' *****************************************************************************
'
27200 CC$ = CHR$(17) + MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
GOSUB 28000
IF CT = 128 THEN _
RETURN
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
GOTO 27200
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE *
' *****************************************************************************
'
27500 USER.BLOCK.LOCK = FALSE
BLK = (USER.FILE.INDEX / 4) + .26
MID$(LOCK.STATUS$,7,2) = "UB"
SUBROUTINE.PARAMETER = 2
CALL LINE25
ON NETWORK.TYPE GOTO 27600,27700,27800
RETURN
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) *
' *****************************************************************************
'
27600 AX = &H100
BX = BLK + 10
CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET) *
' *****************************************************************************
'
27700 CC$ = CHR$(17) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
GOSUB 28000
IF CT = 128 THEN _
RETURN
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
GOTO 27700
'
' *****************************************************************************
' * UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET) *
' *****************************************************************************
'
27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
GOTO 25300
'
' *****************************************************************************
' * CORVUS OMNINET INTERFACE *
' *****************************************************************************
'
28000 CC$ = LINE.FEED$ + CHR$(0) + CHR$(11) + CC$
CALL CDSEND(CC$)
CALL CDRECV(CN$)
CT = ASC(MID$(CN$,3,1))
IF CT >= 128 THEN _
PRINT "CORVUS LOCK FAIL" : _
SUBROUTINE.PARAMETER = -1
28010 CT = ASC(MID$(CN$,4,1))
IF CT >= 129 THEN _
PRINT "CORVUS FULL" : _
SUBROUTINE.PARAMETER = -1
RETURN
'
' *****************************************************************************
' * ORCHID PC-NET INTERFACE *
' *****************************************************************************
'
28100 LOCK.DRIVE = ASC(LEFT$(ACTIVE.USER.FILE$,1))-ASC("A")
LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
STRING$(32-LEN(LOCK.FILE.NAME$),0)
A = 0
RETURN
'
' *****************************************************************************
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ *
' *****************************************************************************
'
29000 MID$(LOCK.STATUS$,10,2) = "LD"
SUBROUTINE.PARAMETER = 2
CALL LINE25
LOCK.FILE.NAME$ = EN$
ON NETWORK.TYPE GOTO 29100,29010,22300
29010 RETURN
'
' *****************************************************************************
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK) *
' *****************************************************************************
'
29100 AX = &H0
BX = &H3
CALL RBBSML(AX,BX)
RETURN
'
' *****************************************************************************
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ *
' *****************************************************************************
'
29500 MID$(LOCK.STATUS$,10,2) = "UD"
SUBROUTINE.PARAMETER = 2
CALL LINE25
LOCK.FILE.NAME$ = EN$
ON NETWORK.TYPE GOTO 29600,29510,25300
29510 RETURN
'
' *****************************************************************************
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK) *
' *****************************************************************************
'
29600 AX = &H100
BX = &H3
CALL RBBSML(AX,BX)
EXIT SUB
END SUB
' $SUBTITLE: 'AMORPM - subroutine to give time of day in AM/PM format'
' $PAGE
'
' SUBROUTINE NAME -- AMORPM
'
' INPUT PARAMETERS -- PARAMETER MEANING
' SUBROUTINE.PARAMETER = 1 GET CURRENT TIME AND DATE
' SUBROUTINE.PARAMETER = 2 CALCULATE TIME AS AM OR PM
'
' OUTPUT PARAMETERS -- CURRENT.DATE$ CURRENT DATE (MM-DD-YY)
' TIM$ CURRENT TIME (I.E. 1:13 PM)
' TIME.LOGGEND.ON$ TIME USER LOGGED ON (HH:MM:SS)
'
' SUBROUTINE PURPOSE -- TO SET THE OUTPUT PARAMETERS AS INDICATED AND
' DESCRIBE THE TIME AS "AM" OR "PM."
'
SUB AMORPM STATIC
ON SUBROUTINE.PARAMETER GOTO 41500,41510
'
' *****************************************************************************
' * CALCULATE CURRENT TIME FOR AM OR PM *
' *****************************************************************************
'
41500 TIME.LOGGED.ON$ = TIME$
CURRENT.DATE$ = LEFT$(DATE$ ,6) + RIGHT$(DATE$ ,2)
41510 TIM$ = TIME$
IF VAL(MID$(TIM$,1,2)) = 12 THEN _
MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))),2) : _
TIM$ = LEFT$(TIM$,5) + " PM" : _
EXIT SUB
IF VAL(MID$(TIM$,1,2)) > 11 THEN _
MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))-12),2) : _
TIM$ = LEFT$(TIM$,5) + " PM" : _
EXIT SUB
TIM$ = LEFT$(TIM$,5) + " AM"
END SUB
' $SUBTITLE: 'CARRIER - subroutine to monitor carrier on comm. port'
' $PAGE
'
' SUBROUTINE NAME -- CARRIER
'
' INPUT PARAMETERS -- PARAMETER MEANING
' LOCAL.USER = 0 REMOTE USER
' LOCAL.USER = -1 LOCAL KEYBOARD USER
' MODEM.STATUS.REGISTER ADDRESS OF THE COMMUNI-
' CATIONS PORT'S REGISTER
'
' OUTPUT PARAMETERS -- SUBROUTINE.PARAMETER = 0 CARRIER STILL PRESENT
' SUBROUTINE.PARAMETER = -1 CARRIER NOT PRESENT
'
' SUBROUTINE PURPOSE -- TO TEST IF CARRIER IS PRESENT (I.E. THE USER
' STILL ON LINE).
'
SUB CARRIER STATIC
SUBROUTINE.PARAMETER = 0
'
' *****************************************************************************
' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT) *
' *****************************************************************************
'
42000 IF LOCAL.USER THEN _
EXIT SUB
42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
EXIT SUB
'
' *****************************************************************************
' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER *
' * DETECT. SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER, *
' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN. *
' *****************************************************************************
'
SUBROUTINE.PARAMETER = 3
CALL DELAYIT
SUBROUTINE.PARAMETER = 0
IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
EXIT SUB
Z$ = "Carrier dropped"
SUBROUTINE.PARAMETER = 1
CALL UPDTCALR
SUBROUTINE.PARAMETER = -1
END SUB
' $SUBTITLE: 'READPROF - subroutine to restore a user profile'
' $PAGE
'
' SUBROUTINE NAME -- READPROF
'
' INPUT PARAMETERS -- PARAMETER MEANING
' NODE.RECORD.INDEX NODE RECORD TO USE
' SYSOP.PASSWORD.1$ SYSOP'S PSEUDONYM 1
' SYSOP.PASSWORD.2$ SYSOP'S PSEUDONYM 2
'
' OUTPUT PARAMETERS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
' UPON EXITING RBBS-PC TO A "DOOR"
'
' SUBROUTINE PURPOSE -- RESET A USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
' THAT WERE SAVED IN THE NODE RECORD WHEN A USER EXITED
' TO A "DOOR" SO THAT HE IS IN THE SAME STATUS AS WHEN
' HE EXITED.
'
SUB READPROF STATIC
'
' *****************************************************************************
' * RESTORE USER PROFILE WHEN RETURNING FROM DOORS *
' *****************************************************************************
'
44000 PRINT "NODE.RECORD.INDEX", NODE.RECORD.INDEX
GET 1,NODE.RECORD.INDEX
EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
PRINT "BPS",BPS
CALL COMMINFO
UPPER.CASE = VAL(MID$(MESSAGE.RECORD$,46,2))
MINUTES.PER.SESSION! = VAL(MID$(MESSAGE.RECORD$,48,5))
GR = VAL(MID$(MESSAGE.RECORD$,53,2))
SYSOP = VAL(MID$(MESSAGE.RECORD$,55,2))
IF BPS = -1 THEN _
BAUD.RATE.DIVISOR = &H180:' 300 BAUD
IF BPS = -2 THEN _
BAUD.RATE.DIVISOR = &H100:' 450 BAUD
IF BPS = -3 THEN _
BAUD.RATE.DIVISOR = &H60:' 1200 BAUD
IF BPS = -4 THEN _
BAUD.RATE.DIVISOR = &H30:' 2400 BAUD
CALL SETBAUD
CALL FINDTIME (USER.LOGON.TIME!)
IF MINUTES.PER.SESSION! < 1 THEN _
MINUTES.PER.SESSION! = 3
IF NOT EIGHT.BIT THEN _
OUT LINE.CONTROL.REGISTER,&H1A
IF SYSOP THEN _
FIRST.NAME$ = SYSOP.PASSWORD.1$ : _
LAST.NAME$ = SYSOP.PASSWORD.2$ : _
EXIT SUB
FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ")
LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$," ")
FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1)
LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END-(FIRST.NAME.END + 1))
ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
Z$ = FIRST.NAME$
END SUB
' $SUBTITLE: 'COMMINFO - subroutine for variable of users baud/parity'
' $PAGE
'
' SUBROUTINE NAME -- COMMINFO
'
' INPUT PARAMETERS -- PARAMETER MEANING
' BPS BAUD RATE INDICATOR
' EIGHT.BIT INDICATE FOR N/8/1
'
' OUTPUT PARAMETERS -- BAUD.PARITY$
'
' SUBROUTINE PURPOSE -- CREATE A STRING THAT SHOWS A USERS BAUD RATE AND
' PARITY.
'
SUB COMMINFO STATIC
'
' *****************************************************************************
' * DETERMINE BAUD AND PARITY *
' *****************************************************************************
'
BAUD.PARITY$ = MID$(" 300 4501200240048009600",(-4*BPS),4) + _
" BAUD," + _
MID$("N,8,1E,7,1",6 + 5*EIGHT.BIT,5)
END SUB
' $SUBTITLE: 'DELAYIT - subroutine to wait number of seconds specified'
' $PAGE
'
' SUBROUTINE NAME -- DELAYIT
'
' INPUT PARAMETERS -- PARAMETER MEANING
' SUBROUTINE.PARAMETER = 1 NUMBER OF SECONDS TO DELAY
' (0 TO 3,600)
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO WAIT THE NUMBER OF SECONDS INDICATED BEFORE
' RETURNING CONTROL TO THE CALLING ROUTINE.
'
SUB DELAYIT STATIC
CALL FINDTIME (DELAY!)
DELAY! = SUBROUTINE.PARAMETER + DELAY!
IF DELAY! < 86400! THEN _
GOTO 50520
50500 CALL FINDTIME (TI!)
IF TI! > SUBROUTINE.PARAMETER THEN _ ' IF SECONDS TO DELAY IS PAST
GOTO 50500 ' MIDNIGHT WAIT FOR THE CLOCK TO WRAP AROUND
DELAY! = DELAY! - 86400! ' TO PAST MIDNIGHT AND ADJUST THE DELAY
50520 CALL FINDTIME (TI!)
IF TI! < DELAY! THEN _
GOTO 50520
END SUB
' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
' $PAGE
'
' SUBROUTINE NAME -- FINDFREE
'
' INPUT PARAMETERS -- PARAMETER MEANING
' Z$ NAME OF FILE TO FIND
'
' OUTPUT PARAMETERS -- FREE.SPACE$ NUMBER OF BYTES FREE
'
' SUBROUTINE PURPOSE -- TO DETERMINE AMOUNT OF FREE SPACE ON A DEVICE
'
SUB FINDFREE STATIC
'
' *****************************************************************************
' * GET FREE SPACE ON DISK *
' *****************************************************************************
'
52000 FREE.SPACE$ = ""
CLS
ON ERROR GOTO 90
52001 FILES Z$
ON ERROR GOTO 0
FOR X = 1 TO 25
FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
NEXT
52002 ON ERROR GOTO 0
SUBROUTINE.PARAMETER = 1
CALL LINE25
END SUB
' $SUBTITLE: 'MODEMPUT - subroutine to write modem commands to modem'
' $PAGE
'
' SUBROUTINE NAME -- MODEMPUT
'
' INPUT PARAMETERS -- PARAMETER MEANING
' A$ MODEM COMMAND
' COMMANDS.BETWEEN.RINGS INDICATOR TO WAIT FOR
' MODEM TO STOP RINGING
' BEFORE ISSUING COMMANDS
' DUMB.MODEM INDICATOR THAT MODEM WOULD
' NOT UNDERSTAND COMMANDS
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
'
SUB MODEMPUT STATIC
'
' *****************************************************************************
' * SEND MODEM COMMAND *
' *****************************************************************************
'
52070 IF DUMB.MODEM THEN _
EXIT SUB
IF COMMANDS.BETWEEN.RINGS THEN _
WHILE(INP(MODEM.STATUS.REGISTER) AND &H40) > 0 : _
WEND
SUBROUTINE.PARAMETER = 1
CALL DELAYIT
PRINT #3,A$
END SUB
' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
' $PAGE
'
' SUBROUTINE NAME -- OPENWORK
'
' INPUT PARAMETERS -- PARAMETER MEANING
' FILE.NAME$ NAME OF FILE TO FIND
' SHARE.IT USE DOS' "SHARE" FACILITIES
'
' OUTPUT PARAMETERS -- EC ERROR CODE
'
' SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2)
'
SUB OPENWORK STATIC
'
' *****************************************************************************
' * OPEN RBBS-PC'S "WORK FILE" (I.E. FILE NUMBER 2) FOR INPUT. OPEN IT AS *
' * "SHARED" IF MULTIPLE COPIES OF RBBS-PC WILL BE RUNNING UNDER THE SAME DOS *
' *****************************************************************************
'
58000 CLOSE 2
58010 EC = 0
ON ERROR GOTO 95
58020 IF SHARE.IT THEN _
OPEN FILE.NAME$ FOR INPUT SHARED AS #2 _
ELSE OPEN FILE.NAME$ FOR INPUT AS #2
58030 ON ERROR GOTO 0
END SUB
' $SUBTITLE: 'FINDFUNC - subroutine to find if function key was pressed'
' $PAGE
'
' SUBROUTINE NAME -- FINDFUNC
'
' INPUT PARAMETERS -- PARAMETER MEANING
' F1.KEY FUNCTION KEY ONE VALUE
' F10.KEY FUNCTION KEY TEN VALUE
'
' OUTPUT PARAMETERS -- FUNCTION.KEY (VALUE 1 TO 10 CORRESPONDING TO
' THE FUNCTION KEY THAT WAS PRESSED).
' KEY.PRESSED$ (CHARACTER STRING INPUTTED).
'
' SUBROUTINE PURPOSE -- TO DETERMINE IF A FUNCTION HAS BEEN PRESSED ON
' THE PC'S KEYBOARD THAT IS RUNNING RBBS-PC.
'
SUB FINDFUNC STATIC
'
' *****************************************************************************
' * TEST FOR FUNCTION KEY PRESSED *
' *****************************************************************************
'
KEY.PRESSED$ = INKEY$
FUNCTION.KEY = 0
IF LEN(KEY.PRESSED$) <> 2 THEN _
EXIT SUB
KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
IF KEY.PRESSED = 79 THEN _
FUNCTION.KEY = 11 : _
EXIT SUB
IF KEY.PRESSED = 73 THEN _
FUNCTION.KEY = 12 : _
EXIT SUB
IF KEY.PRESSED = 81 THEN _
FUNCTION.KEY = 13 : _
EXIT SUB
IF KEY.PRESSED < F1.KEY OR _
KEY.PRESSED > F10.KEY THEN _
EXIT SUB
FUNCTION.KEY = KEY.PRESSED - 58
END SUB
' $SUBTITLE: 'FINDTIME - subroutine to calculate seconds since midnight'
' $PAGE
'
' SUBROUTINE NAME -- FINDTIME
'
' INPUT PARAMETERS -- PARAMETER MEANING
' SECONDS! VARIABLE TO RETURN RESULTS WITH
'
' OUTPUT PARAMETERS -- SECONDS! SECONDS SINCE MIDNIGHT
'
' SUBROUTINE PURPOSE -- TO CALCULATE THE NUMBER OF SECONDS THAT HAVE
' ELASPED SINCE MIDNIGHT
'
SUB FINDTIME (SECONDS!) STATIC
XTIME$ = TIME$
SECONDS! = VAL (RIGHT$(XTIME$,2)) + _
VAL (RIGHT$(XTIME$,5)) * 60 + _
VAL (RIGHT$(XTIME$,8)) * 3600
END SUB
' $SUBTITLE: 'ALLCAPS - subroutine to convert string to upper case'
' $PAGE
'
' SUBROUTINE NAME -- ALLCAPS
'
' INPUT PARAMETERS -- PARAMETER MEANING
' CONVERT.FIELD$ STRING TO MAKE UPPER CASE
'
' OUTPUT PARAMETERS -- CONVERT.FIELD$ CONVERTED STRINGS
'
' SUBROUTINE PURPOSE -- SUBROUTINE TO CONVERT A STRING TO UPPER CASE
'
SUB ALLCAPS (CONVERT.FIELD$) STATIC
FOR Z = 1 TO LEN(CONVERT.FIELD$)
IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
NEXT
END SUB
' $SUBTITLE: 'CHECKTIM - subroutine to see if time has elasped'
' $PAGE
'
' SUBROUTINE NAME -- CHECKTIM
'
' INPUT PARAMETERS -- PARAMETER MEANING
' MAX.TIME! NUMBER OF SECONDS PAST MIDNIGHT
' NOT TO EXCEED
'
' OUTPUT PARAMETERS -- SUBROUTINE.PARAMETER = 1 CURRENT TIME IS LESS THAN
' MAX.TIME!
' SUBROUTINE.PARAMETER = 2 CURRENT TIME IS GREATER THAN
' OR EQUAL TO MAX.TIME!
'
' SUBROUTINE PURPOSE -- SUBROUTINE TO CHECK IF THE CURRENT TIME IS GREATER
' THAN OR EQUAL TO THE TIME ALLOWED
'
SUB CHECKTIM (MAX.TIME!) STATIC
SUBROUTINE.PARAMETER = 1
CALL FINDTIME (TI!)
IF MAX.TIME! < 86400 AND TI! < MAX.TIME! THEN _
EXIT SUB
IF MAX.TIME! < 86400 AND TI! => MAX.TIME! THEN _
SUBROUTINE.PARAMETER = 2 : _
EXIT SUB
TEST.TIME! = MAX.TIME! - 86400
IF TEST.TIME! - TI! <= 0 THEN _
EXIT SUB
IF TI! => TEST.TIME! THEN _
SUBROUTINE.PARAMETER = 2
END SUB